
package Sgdb::SourceSyntaxC ;


#  This is a 'stupid' one function module. It was
#  separated from the Sgdb::SourcePane module for
#  the sake of portability.

use warnings ;
use strict ;
use integer ;
use bytes ;

# Perlon: I've tried putting the different expressions in variables, and
# use them with the m/../o switch, but it seems to run faster this way.

my  $parse = qr{\G              # end of prev match
               (.*?)            # 1. whatever
               (                # 2. match first of:
                                # 3. comment
               ( /\*\*/ |
                 /\*.*?[^\\]\*/ |
                 //.*?\n
                 )
                                |
                                # 4. quote
                ( \"\"            |
                  \" .*? (?:[^\\] |
                          \\ \\
                          ) \"    |
                  \' \\ \\ \'     |
                  \'.\'
                  )
                                |
                                # 5. compiler instructs
                ( (?<=\n) \# .*? [^\\]\n
                  )
                                |
                                # 6. known types

# Perlon: known types and key words are 'unnecessarily short circuit'.
# one way to make this rexp run faster is by optimizing the conditions
# to things like (?:un)?signed, si(?:zeof|gned) or better:
# s (:? hort | izeof | tatic | witch ). i'll go for the last one...

                ( \b (?:
                      s  (?: hort | witch  |
                       i (?: gned | zeof ) |
                       t (?: ruct | atic ))|
                      c  (?: onst | har    )       |
                      un (?: ion  | signed )       |
                      vo (?: id   | latile )       |
                      U? (?: LONG | SHORT  | CHAR )|
                      BOOL (?: EAN )?              |
                      [SU]? INT (?:\d\d)?          |
                      double | float | int | long  | enum
                      ) \b
                  )
                                |
                                # 7. key words
                ( \b (:?
                      re (?: turn  | gister  )  |
                      e  (?: lse   | ntry    )  |
                      c  (?: ase   | ontinue )  |
                      d  (?: o     | efault  )  |
                      p  (?: ublic | rivate  )  |
                      n  (?: ew    | amespace)  |
                      us (?: e     | ing     )  |
                      for  | while | if | break | goto
                      ) \b
                  )
                                |

                                # 8. end of file
                (\z)
                )
               }xs ;

sub parse {

    my $file = shift or die "arg" ;

    unless (open FILE, $file) {

        return ["can't open the file $file: $!\n"] ;
    }

                                # speed, speed and speed

    $file = join '', <FILE> ;
    close FILE ;

    study $file ;
    my @file ;

    while ($file =~ /$parse/go ) {

        push @file, ( $1,     'face-code',
                      $2, qw ( face-comments
                               face-quotations
                               face-instructs
                               face-knowntypes
                               face-keywords
                               face-code
                              ) [$3 ? 0 :
                                 $4 ? 1 :
                                 $5 ? 2 :
                                 $6 ? 3 :
                                 $7 ? 4 :
                                      5 ]
                      ) ;
        # Perlon: this is a C like 'if else if' chain. I wonder
        # if Perl's 'if elsif' chain would yield more optimized
        # byte code.
    }
    \@file ;
}

'end'
